home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / TCOLLECT.FRM < prev    next >
Text File  |  1997-06-14  |  15KB  |  520 lines
  1. VERSION 5.00
  2. Begin VB.Form FTestCollect 
  3.    Caption         =   "Test Collections"
  4.    ClientHeight    =   6330
  5.    ClientLeft      =   1995
  6.    ClientTop       =   1575
  7.    ClientWidth     =   6795
  8.    Icon            =   "TCOLLECT.frx":0000
  9.    LinkTopic       =   "Form1"
  10.    PaletteMode     =   1  'UseZOrder
  11.    ScaleHeight     =   6330
  12.    ScaleWidth      =   6795
  13.    WhatsThisHelp   =   -1  'True
  14.    Begin VB.CheckBox chkOld 
  15.       Caption         =   "Old version"
  16.       Height          =   252
  17.       Left            =   120
  18.       TabIndex        =   15
  19.       Top             =   5040
  20.       Width           =   1332
  21.    End
  22.    Begin VB.CommandButton cmdDrives 
  23.       Caption         =   "Drives"
  24.       Height          =   492
  25.       Left            =   120
  26.       MaskColor       =   &H00000000&
  27.       TabIndex        =   14
  28.       Top             =   4440
  29.       Width           =   1332
  30.    End
  31.    Begin VB.Frame fm 
  32.       Caption         =   "Stack Type"
  33.       Height          =   1512
  34.       Left            =   120
  35.       TabIndex        =   8
  36.       Top             =   2508
  37.       Width           =   1356
  38.       Begin VB.TextBox txtCount 
  39.          Height          =   288
  40.          Left            =   720
  41.          TabIndex        =   12
  42.          Text            =   "2000"
  43.          Top             =   1080
  44.          Width           =   492
  45.       End
  46.       Begin VB.OptionButton optStack 
  47.          Caption         =   "List"
  48.          Height          =   255
  49.          Index           =   0
  50.          Left            =   84
  51.          MaskColor       =   &H00000000&
  52.          TabIndex        =   11
  53.          Top             =   240
  54.          Value           =   -1  'True
  55.          Width           =   960
  56.       End
  57.       Begin VB.OptionButton optStack 
  58.          Caption         =   "Vector"
  59.          Height          =   255
  60.          Index           =   1
  61.          Left            =   84
  62.          MaskColor       =   &H00000000&
  63.          TabIndex        =   10
  64.          Top             =   480
  65.          Width           =   972
  66.       End
  67.       Begin VB.OptionButton optStack 
  68.          Caption         =   "Collection"
  69.          Height          =   255
  70.          Index           =   2
  71.          Left            =   84
  72.          MaskColor       =   &H00000000&
  73.          TabIndex        =   9
  74.          Top             =   720
  75.          Width           =   1032
  76.       End
  77.       Begin VB.Label lbl 
  78.          Caption         =   "Count:"
  79.          Height          =   252
  80.          Left            =   120
  81.          TabIndex        =   13
  82.          Top             =   1080
  83.          Width           =   612
  84.       End
  85.    End
  86.    Begin VB.CommandButton cmdVector 
  87.       Caption         =   "Vector"
  88.       Height          =   504
  89.       Left            =   120
  90.       MaskColor       =   &H00000000&
  91.       TabIndex        =   7
  92.       Top             =   1320
  93.       Width           =   1335
  94.    End
  95.    Begin VB.CommandButton cmdList 
  96.       Caption         =   "Linked List"
  97.       Height          =   504
  98.       Left            =   120
  99.       TabIndex        =   6
  100.       Top             =   720
  101.       Width           =   1332
  102.    End
  103.    Begin VB.ListBox lstStuff 
  104.       Height          =   450
  105.       Left            =   5520
  106.       TabIndex        =   5
  107.       Top             =   4920
  108.       Width           =   1215
  109.    End
  110.    Begin VB.CommandButton cmdExit 
  111.       Caption         =   "Exit"
  112.       Height          =   495
  113.       Left            =   120
  114.       MaskColor       =   &H00000000&
  115.       TabIndex        =   4
  116.       Top             =   5760
  117.       Width           =   1335
  118.    End
  119.    Begin VB.CommandButton cmdInternal 
  120.       Caption         =   "Internal"
  121.       Height          =   384
  122.       Left            =   5520
  123.       MaskColor       =   &H00000000&
  124.       TabIndex        =   3
  125.       Top             =   5880
  126.       Width           =   1212
  127.    End
  128.    Begin VB.CommandButton cmdStack 
  129.       Caption         =   "Stack"
  130.       Height          =   495
  131.       Left            =   96
  132.       MaskColor       =   &H00000000&
  133.       TabIndex        =   2
  134.       Top             =   1908
  135.       Width           =   1335
  136.    End
  137.    Begin VB.CommandButton cmdCollect 
  138.       Caption         =   "Collection"
  139.       Height          =   495
  140.       Left            =   120
  141.       MaskColor       =   &H00000000&
  142.       TabIndex        =   1
  143.       Top             =   120
  144.       Width           =   1335
  145.    End
  146.    Begin VB.TextBox txtOut 
  147.       Height          =   4695
  148.       Left            =   1644
  149.       MultiLine       =   -1  'True
  150.       ScrollBars      =   2  'Vertical
  151.       TabIndex        =   0
  152.       Top             =   120
  153.       Width           =   5052
  154.    End
  155. End
  156. Attribute VB_Name = "FTestCollect"
  157. Attribute VB_GlobalNameSpace = False
  158. Attribute VB_Creatable = False
  159. Attribute VB_PredeclaredId = True
  160. Attribute VB_Exposed = False
  161. Option Explicit
  162.  
  163.  
  164. Private Sub cmdCollect_Click()
  165.     Dim s As String
  166.     ' Declare collection
  167.     Dim animals As New Collection
  168.         
  169.     s = "Add items to collection: Lion, Tiger, Bear, Shrew before 1, Weasel after 1" & sCrLf
  170.     ' Create collection
  171.     animals.Add "Lion"
  172.     animals.Add "Tiger"
  173.     animals.Add "Bear"
  174.     animals.Add "Shrew", , 1
  175.     animals.Add "Weasel", , , 1
  176.         
  177.     ' Access collection items
  178.     Debug.Print animals(3) & " " & animals.Item(3)
  179.     
  180.     ' Iterate through collection
  181.     s = s & sCrLf & "Iterate with For Each: " & sCrLf
  182.     Dim vAnimal As Variant
  183.     For Each vAnimal In animals
  184.         s = s & Space$(4) & vAnimal & sCrLf
  185.         Debug.Print vAnimal
  186.     Next
  187.     
  188.     ' Replace collection item
  189.     s = s & "Access item 2: " & animals.Item(2) & sCrLf
  190.     s = s & "Replace " & animals.Item(2) & " with Wolverine" & sCrLf
  191.     'animals(2) = "Wolverine"
  192.     'Set animals(2) = "Wolverine"
  193.     animals.Add "Wolverine", , 2
  194.     animals.Remove 3
  195.         
  196.     s = s & sCrLf & "Iterate with For I: " & sCrLf
  197.     Dim i As Integer
  198.     For i = 1 To animals.Count
  199.         s = s & Space$(4) & animals(i) & sCrLf
  200.         Debug.Print animals(i)
  201.     Next
  202.     
  203.     Dim vAnimal2 As Variant
  204.     s = s & sCrLf & "Nested iteration loops with For Each: " & sCrLf
  205.     For Each vAnimal In animals
  206.         s = s & Space$(4) & vAnimal & sCrLf
  207.         If vAnimal = "Lion" Then
  208.             For Each vAnimal2 In animals
  209.                 s = s & Space$(8) & vAnimal2 & sCrLf
  210.             Next
  211.         End If
  212.     Next
  213.     
  214.     BugMessage s
  215.     txtOut.Text = s
  216.    
  217. End Sub
  218.  
  219. Private Sub cmdDrives_Click()
  220.     txtOut.Text = sEmpty
  221.     txtOut.Refresh
  222.     Dim s As String
  223.    
  224.     Dim driveCur As New CDrive
  225.     driveCur = 0       ' Initialize to current drive
  226.     
  227.     Debug.Print driveCur
  228.     s = "Drive information for current drive:" & sCrLf
  229.     Const sBFormat = "#,###,###,##0"
  230.     With driveCur
  231.         s = s & "Drive " & .Root & " [" & .Label & ":" & _
  232.                 .Serial & "] (" & .KindStr & ") has " & _
  233.                 Format$(.FreeBytes, sBFormat) & " free from " & _
  234.                 Format$(.TotalBytes, sBFormat) & sCrLf
  235.     End With
  236.     
  237.     driveCur = "C:\"       ' Initialize to current drive
  238.     
  239.     s = "Drive information for drive C:" & sCrLf
  240.     Debug.Print driveCur
  241.     With driveCur
  242.         s = s & "Drive " & .Root & " [" & .Label & ":" & _
  243.                 .Serial & "] (" & .KindStr & ") has " & _
  244.                 Format$(.FreeBytes, sBFormat) & " free from " & _
  245.                 Format$(.TotalBytes, sBFormat) & sCrLf
  246.     End With
  247.     
  248.     s = s & sCrLf
  249.     s = s & "Drive information for available drives:" & sCrLf
  250.     Dim drives As Object, drive As CDrive
  251.     If chkOld Then
  252.         Set drives = New CDrivesO
  253.     Else
  254.         Set drives = New CDrives
  255.     End If
  256.     For Each drive In drives
  257.         With drive
  258.             s = s & "Drive " & .Root & " [" & .Label & ":" & _
  259.                     .Serial & "] (" & .KindStr & ") has " & _
  260.                     Format$(.FreeBytes, sBFormat) & " free from " & _
  261.                     Format$(.TotalBytes, sBFormat) & sCrLf
  262.         End With
  263.     Next
  264.     Debug.Print drives("C:\").Label
  265.     
  266.     BugMessage s
  267.     txtOut.Text = s
  268. End Sub
  269.  
  270. Private Sub cmdExit_Click()
  271.     Unload Me
  272. End Sub
  273.  
  274. Private Sub cmdInternal_Click()
  275.     Dim s As String, i As Integer
  276.     s = "Forms collection:" & sCrLf
  277.     Dim obj As Object
  278.     For Each obj In Forms
  279.         s = s & obj.Name & sCrLf
  280.         Debug.Print obj.Name
  281.     Next
  282.     
  283.     s = s & sCrLf & "Controls collection:" & sCrLf
  284.     Dim ctl As Control
  285.     For Each ctl In Controls
  286.         s = s & ctl.Name & sCrLf
  287.         Debug.Print ctl.Name
  288.     Next
  289.     
  290.     s = s & sCrLf & "Printers collection:" & sCrLf
  291.     Dim prt As Printer
  292.     For Each prt In Printers
  293.         s = s & prt.DriverName & sCrLf
  294.         Debug.Print prt.CurrentX ' .DriverName
  295.         ' Do something with each prt
  296.     Next
  297.     
  298.     s = s & sCrLf & "Control array:" & sCrLf
  299.     For Each ctl In optStack
  300.         s = s & ctl.Caption & Space$(4) & ctl.Value & sCrLf
  301.         Debug.Print ctl.Caption & Space$(4) & ctl.Value
  302.     Next
  303.     
  304.     For i = optStack.LBound To optStack.UBound
  305.         s = s & optStack(i).Caption & Space$(4) & optStack(i).Value & sCrLf
  306.         Debug.Print optStack(i).Caption & Space$(4) & optStack(i).Value
  307.     Next
  308.  
  309.     lstStuff.AddItem "Lions"
  310.     lstStuff.AddItem "Tigers"
  311.     lstStuff.AddItem "Bears"
  312.     
  313.     Debug.Print lstStuff.list(1)
  314.  
  315.     ' You can't do that!
  316.     'For Each obj In lstStuff
  317.     '    Debug.Print obj.Name
  318.     'Next
  319.     
  320.     s = s & sCrLf & "ListBox:" & sCrLf
  321.     For i = 0 To lstStuff.ListCount - 1
  322.         s = s & lstStuff.list(i) & sCrLf
  323.         Debug.Print lstStuff.list(i)
  324.     Next
  325.     
  326.     BugMessage s
  327.     txtOut.Text = s
  328.  
  329. End Sub
  330.  
  331. Private Sub cmdList_Click()
  332.     Dim s As String
  333.     
  334.     s = "Add items:" & sCrLf & _
  335.         Space$(4) & "Add Bear, Tiger, Lion, Elephant, Horse, Dog" & sCrLf
  336.     ' Insert item into list
  337.     Dim list As New CList
  338.     list.Add "Bear"
  339.     list.Add "Tiger"
  340.     list.Add "Lion"
  341.     list.Add "Elephant"
  342.     list.Add "Horse"
  343.     list.Add "Dog"
  344.     s = s & "Count: " & list.Count & sCrLf
  345.     s = s & "Head: " & list & sCrLf
  346.     s = s & "Item 2: " & list(2) & sCrLf
  347.     s = s & "Item Tiger: " & list("Tiger") & sCrLf
  348.     
  349.     s = s & "Iterate:" & sCrLf
  350.     Dim walker As New CListWalker
  351.     walker.Attach list
  352.     Do While walker.More
  353.         s = s & Space$(4) & walker & sCrLf
  354.     Loop
  355.     
  356.     s = s & "Replace Elephant with Pig" & sCrLf
  357.     list("Elephant") = "Pig"
  358.     
  359.     s = s & "Remove head: " & list & sCrLf
  360.     list.Remove
  361.     s = s & "Remove Bear" & sCrLf
  362.     list.Remove "Bear"
  363.     s = s & "Remove 3: " & list(3) & sCrLf
  364.     list.Remove 3
  365.     
  366.     Dim walker2 As New CListWalker
  367.     s = s & "Nesting iterate:" & sCrLf
  368.     walker.Attach list
  369.     Do While walker.More
  370.         s = s & Space$(4) & walker & sCrLf
  371.         If walker = "Pig" Then
  372.             walker2.Attach list
  373.             s = s & Space$(4) & "Nested iterate:" & sCrLf
  374.             Do While walker2.More
  375.                 s = s & Space$(8) & walker2 & sCrLf
  376.             Loop
  377.         End If
  378.     Loop
  379.  
  380.     s = s & "Iterate with For Each:" & sCrLf
  381.     Dim v As Variant
  382.     For Each v In list
  383.         s = s & Space$(4) & "V: " & v & sCrLf
  384.     Next
  385.         
  386.     s = s & "Clear and then iterate:" & sCrLf
  387.     list.Clear
  388.     For Each v In list
  389.         s = s & Space$(4) & "V: " & v & sCrLf
  390.     Next
  391.     
  392.     BugMessage s
  393.     txtOut.Text = s
  394. End Sub
  395.  
  396. Private Sub cmdStack_Click()
  397.     Dim s As String
  398.     s = "Push animals onto stack: " & sCrLf
  399.     txtOut.Text = s
  400.     txtOut.Refresh
  401.     Dim beasts As IStack
  402.     Select Case GetOption(optStack)
  403.     Case 0
  404.         Set beasts = New CStackLst
  405.     Case 1
  406.         Set beasts = New CStackVec
  407.     Case 2
  408.         Set beasts = New CStackCol
  409.     End Select
  410.     s = s & Space$(4) & "Push Lion" & sCrLf
  411.     beasts.Push "Lion"
  412.     s = s & Space$(4) & "Push Tiger" & sCrLf
  413.     beasts.Push "Tiger"
  414.     s = s & Space$(4) & "Push Bear" & sCrLf
  415.     beasts.Push "Bear"
  416.     s = s & Space$(4) & "Push Shrew" & sCrLf
  417.     beasts.Push "Shrew"
  418.     s = s & Space$(4) & "Push Weasel" & sCrLf
  419.     beasts.Push "Weasel"
  420.     s = s & Space$(4) & "Push Yetti" & sCrLf
  421.     beasts.Push "Yetti"
  422.     
  423.     s = s & "Pop animals off stack: " & sCrLf
  424.     Do While beasts.Count
  425.         s = s & Space$(4) & "Pop " & beasts.Pop & sCrLf
  426.     Loop
  427.            
  428.     Dim numbers As IStack
  429.     Select Case GetOption(optStack)
  430.     Case 0
  431.         Set numbers = New CStackLst
  432.     Case 1
  433.         Set numbers = New CStackVec
  434.     Case 2
  435.         Set numbers = New CStackCol
  436.     End Select
  437.     Dim i As Integer, sec As Currency, secDone As Currency
  438.     ProfileStart sec
  439.     For i = 1 To txtCount
  440.         numbers.Push i
  441.     Next
  442.     Do
  443.         i = numbers.Pop
  444.     Loop While numbers.Count
  445.     ProfileStop sec, secDone
  446.     s = s & sCrLf & "Push/Pop Timing: " & secDone & sCrLf
  447.     
  448.     Dim langs As New CStack
  449.     s = s & sCrLf & "Push languages onto real stack..." & sCrLf
  450.     
  451.     s = s & Space$(4) & "Push Basic" & sCrLf
  452.     langs.Push "Basic"
  453.     s = s & Space$(4) & "Push Pascal" & sCrLf
  454.     langs.Push "Pascal"
  455.     s = s & Space$(4) & "Push C++" & sCrLf
  456.     langs.Push "C++"
  457.     s = s & Space$(4) & "Push Java" & sCrLf
  458.     langs.Push "Java"
  459.     s = s & Space$(4) & "Push REXX" & sCrLf
  460.     langs.Push "REXX"
  461.     s = s & Space$(4) & "Push Forth" & sCrLf
  462.     langs.Push "Forth"
  463.         
  464.     s = s & "Pop languages off stack: " & sCrLf
  465.     Do While langs.Count
  466.         s = s & Space$(4) & "Pop " & langs.Pop & sCrLf
  467.     Loop
  468.     
  469.     BugMessage s
  470.     txtOut.Text = s
  471.     
  472. End Sub
  473.  
  474. Private Function CertifyCollection(obj As Object) As Boolean
  475.     Dim v As Variant
  476.     With obj
  477.         On Error Resume Next
  478.         .Add .Count         ' Test Add and Count by adding
  479.         v = .Item(.Count)   ' Test Item by accessing
  480.         For Each v In obj   ' Test iteration
  481.         Next
  482.         .Remove .Count      ' Test Remove by removing
  483.         CertifyCollection = (Err = 0)
  484.     End With
  485. End Function
  486.         
  487. Private Sub cmdVector_Click()
  488.  
  489.     Dim vector As New CVector, i As Long, s As String
  490.     s = "Insert numbers in vector: " & sCrLf
  491.     For i = 1 To 15
  492.         vector(i) = i * i
  493.         s = s & Space$(4) & i * i & ": vector(" & i & ")" & sCrLf
  494.     Next
  495.     s = s & "Read numbers from vector: " & sCrLf
  496.     For i = 1 To vector.Last
  497.         s = s & Space$(4) & "vector(" & i & ") = " & vector(i) & sCrLf
  498.     Next
  499.     s = s & "Shrink vector to 5 and read numbers: " & sCrLf
  500.     vector.Last = 5
  501.     For i = 1 To vector.Last
  502.         s = s & Space$(4) & "vector(" & i & ") = " & vector(i) & sCrLf
  503.     Next
  504.     
  505.     s = s & "Read numbers with For Each: " & sCrLf
  506.     Dim v As Variant
  507.     For Each v In vector
  508.         s = s & Space$(4) & "v = " & v & sCrLf
  509.     Next
  510.     BugMessage s
  511.     txtOut = s
  512. End Sub
  513.  
  514. Private Sub optStack_Click(Index As Integer)
  515.     txtOut = sEmpty
  516. End Sub
  517.  
  518.  
  519.  
  520.